home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / XGRAPH.LZH / ZOO2.PAS < prev   
Pascal/Delphi Source File  |  1987-03-09  |  17KB  |  483 lines
  1. { Graphics demo, it shows some the animal-curves generated between two  }
  2. { endpoints.                                                            }
  3. {                                                                       }
  4. { Warning, This demo can have habit forming effects!, some programmers  }
  5. { have given up lots of useful hours to stare at the pretty patterns in }
  6. { the screen.                                                           }
  7. {                                                                       }
  8. { Written by Abe Achkinazi on May 1986. Curve type "sines" thanks to    }
  9. { and idea by Roderick Young.                                           }
  10. { Modified to use Extended Graphics Routines in September 1986.         }
  11. {                                                                       }
  12. { Permission to distribute, change, mutilate and learn from this        }
  13. { program is granted.                                                   }
  14. {                                                                       }
  15. program zoo(input,output);
  16.  
  17. {$I Xgraph.pas}
  18.  
  19. label ErrorExit;
  20. const
  21.   max_point = 60;                      { Controls the number of points }
  22.                                         { per curve                     }
  23.  
  24.   x1 = 0; y1 = 1; x2 = 2; y2 = 3;       { constants used to access array }
  25.                                         { 'points'                       }
  26.  
  27. type
  28.   { Some the possible paths for the curves }
  29.   curve_type = ( sines, sines2, random1, planar, square1, general );
  30.  
  31.   { Common data structure for all animal-curves }
  32.   list_type = record
  33.                 { Reseed constant }
  34.                 reseed : integer;
  35.  
  36.                 { Time slice variables }
  37.                 slice_const, slice_counter : integer;
  38.  
  39.                 { Window descriptor }
  40.                 top_x, top_y, length, width : integer;
  41.  
  42.                 { Maintain track of previous points }
  43.                 points : array [0..3, 0..max_point] of integer;
  44.                 last_point : integer;
  45.                 start : integer;
  46.  
  47.                 { curve related parameters }
  48.                 case what_path: curve_type of
  49.                   sines, sines2
  50.                           : ( omega : array [0..3] of real;
  51.                             increment, delta_increment : real );
  52.                   random1 : ( x1_temp, y1_temp, x2_temp, y2_temp,
  53.                               rx1, ry1, rx2, ry2: real );
  54.                   planar  : ( steps : integer;
  55.                               x, y, px1, py1, dx1, dy1, px2, py2,
  56.                               dx2, dy2 : integer;
  57.                               border : integer );
  58.                   square1 : ( sq1_steps : integer );
  59.                   general : ( parms : array [0..5] of real )
  60.               end;
  61.  
  62. var
  63.   GrfData : GraphicsData;
  64.   Regs : VidRegs;
  65.   BlitParms : BlitParm;
  66.   { Actual curves variables }
  67.   list, list2, list3, list4, list5 : list_type;
  68.  
  69.   { Frame buffer size variables }
  70.   OneThird, OneHalf, TwoThird : integer;
  71.  
  72.   ScreenMode : integer;
  73.  
  74. function GetMode(var ScreenMode: integer):boolean;
  75. {             
  76.         Function to check if a parameter was passed and if its valid.
  77. }
  78. var
  79.   Code : integer;
  80. begin
  81.   if (ParamCount < 1) or (ParamCount > 1) then GetMode := false
  82.   else begin { At least has some parameter see if its legal }
  83.     Val(ParamSTR(1), ScreenMode, Code);
  84.     if Code <> 0 then GetMode := false
  85.     else if ScreenMode in [Video320x200BW, Video320x200Color, Video640x200,
  86.        VideoEGA320x200, VideoEGA640x200, VideoEGA640x350Mono, VideoEGA640x350Color,
  87.        VideoMulti640x400, VideoMulti320x400]
  88.     then GetMode := true                        
  89.     else GetMode := false;
  90.   end;
  91. end; { of GetMode } 
  92.  
  93. function previous_point( i, last_point : integer ): integer;
  94. begin
  95.   if i = 0 then previous_point := last_point;
  96. end;
  97.  
  98. function next_point(i, last_point : integer ): integer;
  99. begin
  100.   next_point := (i+1) mod (last_point+1);
  101. end;
  102.  
  103. procedure draw_border(list : list_type);
  104. begin
  105.   with list, Regs do begin
  106.     ax:=VidLine shl 8 + $78 { white solid line };
  107.     cx:=top_x; dx:=top_y; si:=top_x + width; di:=top_y;
  108.     Intr(VideoInt, Regs);
  109.  
  110.     cx:=top_x + width; dx:=top_y; si:=top_x + width;
  111.     di:=top_y + length; Intr(VideoInt, Regs);
  112.  
  113.     cx:=top_x + width; dx:=top_y + length; si:=top_x;
  114.     di:=top_y + length; Intr(VideoInt, Regs);
  115.  
  116.     cx:=top_x; dx:=top_y + length; si:=top_x; di:=top_y;
  117.     Intr(VideoInt, Regs);
  118.   end;
  119. end;
  120.  
  121. procedure clear_window(list : list_type);
  122. begin
  123.   with list, BlitParms do begin
  124.     { Clear the currently selected window }
  125.     Regs.ax := VidBlit shl 8; Regs.bx := $000F;
  126.     Regs.ds := seg(BlitParms); Regs.si := ofs(BlitParms);
  127.     DestOffset := ofs(GrfData); DestSegment := seg(GrfData);
  128.     SrcOffset := ofs(GrfData); SrcSegment := seg(GrfData);
  129.     RectOrigenX := top_x*GrfData.BitPixelDensity; RectOrigenY := top_y;
  130.     RectCornerX := (top_x+width)*GrfData.BitPixelDensity;
  131.         RectCornerY := top_y+length;
  132.     PointX := RectOrigenX; PointY := RectOrigenY;
  133.     Opcode := Blit0; TextOp := TextS;
  134. { Inline($CC); }
  135.     Intr(VideoInt, Regs);
  136.   end;
  137. end;
  138.  
  139. procedure draw_line( list: list_type );
  140. var i,j,k : integer;
  141. begin
  142.   with list, Regs do begin
  143.     case what_path of
  144.       sines, planar, square1: begin
  145.         i := next_point(start, last_point); { Calculate next line to be used }
  146.  
  147.         { Erase the last line in the list }
  148.         ax:=VidLine shl 8+$7F {Back Solid Line };
  149.         cx:=points[x1,i]; dx:=points[y1,i]; si:=points[x2,i]; di:=points[y2,i];
  150.         Intr(VideoInt, Regs);
  151.  
  152.         { draw the current line }
  153.         { Pick color and pattern base on table pos.}
  154.         ax:=VidLine shl 8+(Start mod 15+1)*8+(Start mod 7);
  155.         cx:=points[x1,start]; dx:=points[y1,start]; si:=points[x2,start];
  156.         di:=points[y2,start]; Intr(VideoInt, Regs); end;
  157.  
  158.       sines2 : begin
  159.         i := next_point(start, last_point);
  160.         k := next_point(i, last_point);
  161.         j := previous_point(start, last_point);
  162.         ax:=VidLine shl 8+(i mod 15+1)*8 { Pick color base on table pos.};
  163.         cx:=points[x1,i]; dx:=points[y1,i]; si:=points[x1,k]; 
  164.         di:=points[y1,k]; Intr(VideoInt, Regs);
  165.         cx:=points[x2,i]; dx:=points[y2,i]; si:=points[x2,k]; 
  166.         di:=points[y2,k]; Intr(VideoInt, Regs);
  167.       end;
  168.  
  169.       random1: begin
  170.         i := next_point(start, last_point); { Calculate next line to be used }
  171.  
  172.         { Erase the last line in the list }
  173.         ax:=VidLine shl 8+$7F {Back Solid Line };
  174.         cx:=points[x1,i]; dx:=points[y1,i]; si:=points[x2,i]; di:=points[y2,i];
  175.         Intr(VideoInt, Regs);
  176.  
  177.         { draw the current line }
  178.         { Pick color and pattern base on table pos.}
  179.         ax:=VidLine shl 8+(Start mod 15+1)*8+(Start mod 7);
  180.         cx:=points[x1,start]; dx:=points[y1,start]; si:=points[x2,start];
  181.         di:=points[y2,start]; Intr(VideoInt, Regs); end
  182.  
  183.     end; { of what_curve case }
  184.   end;
  185. end;
  186.  
  187. { Used by Random1 curve path, it reverses direction in the x-sense }
  188. function oppx(border : integer; list : list_type): integer;
  189. begin
  190.   with list do case border of
  191.     0, 2 : oppx := top_x + random(width);
  192.     1    : oppx := top_x + random(width);
  193.     3    : oppx := top_x + random(width)
  194.   end;
  195. end;
  196.  
  197. { Used by Random1 curve path, it reverses direction in the y-sense }
  198. function oppy(border : integer; list : list_type): integer;
  199. begin
  200.   with list do case border of
  201.     0   : oppy := top_y + random(length);
  202.     1,3 : oppy := top_y + random(length);
  203.     2   : oppy := top_y + random(length);
  204.   end;
  205. end;
  206.  
  207. function adjx(var border : integer; list : list_type): integer;
  208. begin
  209.   with list do case border of
  210.     0, 2: if random(2)=0 then begin
  211.             border := 3;
  212.             adjx := (top_x+1) + random(width-2); end
  213.           else begin
  214.             border := 1;
  215.             adjx := (top_x+1) + random(width-2); end;
  216.     1, 3: begin
  217.             if random(2) = 0 then border := 2
  218.                              else border := 0;
  219.             adjx := (top_x+1) + random(width-2);
  220.           end
  221.   end;
  222. end;
  223.  
  224. function adjy(border: integer; list: list_type): integer;
  225. begin
  226.     adjy := (list.top_y+1) + random(list.length-2);
  227. end;
  228.  
  229. { Calculates what is the next set of points for the curve path }
  230. procedure calc (var list : list_type);
  231. begin
  232.   with list do begin
  233.     case what_path of
  234.       sines, sines2 : begin
  235.         increment := increment + delta_increment;
  236.         points[x1,start] :=
  237.           (top_x+1) + round(((sin(omega[x1]*increment)+1.0) / 2.0) * (width-2));
  238.         points[y1,start] :=
  239.           (top_y+1) + round(((sin(omega[y1]*increment)+1.0) / 2.0) * (length-2));
  240.         points[x2,start] :=
  241.           (top_x+1) + round(((sin(omega[x2]*increment)+1.0) / 2.0) * (width-2));
  242.         points[y2,start] :=
  243.           (top_y+1) + round(((sin(omega[y2]*increment)+1.0) / 2.0) * (length-2));
  244.       end;
  245.  
  246.       random1 : begin
  247.         x1_temp := ((random * 2.0) - 1.0) / 10.0;
  248.         y1_temp := ((random * 2.0) - 1.0) / 10.0;
  249.         x2_temp := ((random * 2.0) - 1.0) / 10.0;
  250.         y2_temp := ((random * 2.0) - 1.0) / 10.0;
  251.  
  252.         rx1 := rx1 + x1_temp;
  253.         if rx1 > 1.0 then rx1 := 1.0
  254.           else if rx1 < 0.0 then rx1 := 0.0;
  255.  
  256.         ry1 := ry1 + y1_temp;
  257.         if ry1 > 1.0 then ry1 := 1.0
  258.           else if ry1 < 0.0 then ry1 := 0.0;
  259.  
  260.         rx2 := rx2 - x2_temp;
  261.         if rx2 > 1.0 then rx2 := 1.0
  262.           else if rx2 < 0.0 then rx2 := 0.0;
  263.  
  264.         ry2 := ry2 - y2_temp;
  265.         if ry2 > 1.0 then ry2 := 1.0
  266.           else if ry2 < 0.0 then ry2 := 0.0;
  267.  
  268.         points[x1,start] := (top_x+1) + round(rx1 * (width-2));
  269.         points[y1,start] := (top_y+1) + round(ry1 * (length-2));
  270.         points[x2,start] := (top_x+1) + round(rx2 * (width-2));
  271.         points[y2,start] := (top_y+1) + round(ry2 * (length-2));
  272.       end;
  273.  
  274.       square1: begin end;
  275.  
  276.       planar: begin
  277.         if steps = 0 then begin
  278.           steps := 7 + random(5);
  279.           x := px1; y := py1; px2 := px1; py2 := py1;
  280.           dx2 := (oppx(border, list) - x) div steps;
  281.           dy2 := (oppy(border, list) - y) div steps;
  282.           dx1 := (adjx(border, list) - x) div steps;
  283.           dy1 := (adjy(border, list) - y) div steps;
  284.         end;
  285.         px1 := px1 + dx1; py1 := py1 + dy1;
  286.         px2 := px2 + dx2; py2 := py2 + dy2;
  287.         points[x1,start] := px1; points[y1,start] := py1;
  288.         points[x2,start] := px2; points[y2,start] := py2;
  289.         steps := steps - 1;
  290.       end
  291.     end;
  292.   end;
  293. end;
  294.  
  295. { Fills up the curve's queues with new points, and initializes all      }
  296. { other variables needed for this curve.                                }
  297. procedure Seed( var list : list_type;
  298.                 dummy_x, dummy_y, wide, tall : integer;
  299.                 curve : curve_type );
  300. var i : integer;
  301. begin
  302.   with list do begin
  303.     { Initialize window }
  304.     top_x := dummy_x; top_y := dummy_y; length := tall; width := wide;
  305.  
  306.     draw_border(list);
  307.  
  308.     { Initialize Path related parameters }
  309.     what_path := curve;
  310.     case what_path of
  311.       sines, sines2: begin
  312.                omega[x1] := Random;
  313.                omega[y1] := Random;
  314.                omega[x2] := Random;
  315.                omega[y2] := Random;
  316.                increment := 0; delta_increment := 0.2;
  317.                last_point := 15 + random(5);
  318.              end;
  319.       random1: begin
  320.                  rx1 := random; ry1 := random;
  321.                  rx2 := random; ry2 := random;
  322.                  last_point := 10 + random(5);
  323.                end;
  324.       square1: begin end;
  325.       planar: begin
  326.                 border := random(4);
  327.                 px1 := top_x + random(width);
  328.                 py1 := top_y + random(length);
  329.                 last_point := 10 + random(15);
  330.                 steps := 0;
  331.               end
  332.  
  333.     end; { of case curve }
  334.  
  335.     { Initialize point array }
  336.     start := 0;
  337.     for i := 0 to (last_point+1) do begin
  338.       start := next_point(list.start,list.last_point);
  339.       calc(list);
  340.     end;
  341.  
  342.     { Initialize time slice variables }
  343.     slice_const := 0;
  344.     slice_counter := 0;
  345.  
  346.     reseed := 100 + random(200);
  347.  
  348.   end; { of with list }
  349.  
  350. end; { of Seed }
  351.  
  352. { Performs one step of the given curve. It takes care of all            }
  353. { housekeeping issues such as adjusting curves timers and reseeding     }
  354. { if needed.                                                            }
  355. procedure Step(var list: list_type);
  356. begin
  357.     list.slice_counter := list.slice_counter - 1;
  358.     if list.slice_counter <= 0 then begin
  359.       Calc(list);
  360.       Draw_line(list);
  361.       list.start := next_point(list.start, list.last_point);
  362.       list.slice_counter := list.slice_const;
  363.    end;
  364.    list.reseed := list.reseed - 1;
  365.    if list.reseed = 0 then begin
  366.     clear_window(list);
  367.     Seed(list, list.top_x, list.top_y, list.width, list.length, list.what_path);
  368.    end;
  369.  
  370. end; { of Step }
  371.  
  372. function Trim( n :integer):integer;
  373. {
  374.     Function to guarantee that the result is always byte aligned on the
  375.     right (always ends in bit 7).
  376. }
  377. begin
  378.   if (n mod 8) <> 6 then Trim := (n div 8) * 8 - 2
  379.     else Trim := n;
  380. end;
  381.  
  382. function Clip( n : integer):integer;
  383. {
  384.     Function to gurantee that the result is always byte align on the
  385.     left (always ends in bit 0).
  386. }
  387. begin
  388.   if (n mod 8) <> 0 then Clip := (n div 8) * 8
  389.     else Clip := n;
  390. end;
  391.  
  392. begin
  393. Regs.ax := VidSetMode shl 8 + 03; Intr(VideoInt, Regs); { Clear Screen in Alpha }
  394.  
  395. { Check to make sure that video extensions are installed }
  396. Regs.ax := VidID * 256; Regs.bx := 0; Intr(VideoInt, Regs);
  397. if Regs.bx = 0 then begin
  398.   Writeln('Extended Graphics functions not installed.');
  399.   writeln('Hit return to exit');
  400.   readln;
  401.   goto ErrorExit;
  402. end;
  403.  
  404. { See if user passed legal parameter }
  405. if not GetMode(ScreenMode) then begin
  406.   writeln('Usage: Zoo2 x');
  407.   writeln('where x is a legal graphics mode number from this list:');
  408.   writeln;
  409.   writeln(' 4) is CGA 320x200');
  410.   writeln(' 5) CGA 320x200');
  411.   writeln(' 6) CGA 640x200');
  412.   writeln('13) EGA 320x200');
  413.   writeln('14) EGA 640x200');
  414.   writeln('15) EGA 640x350 Monochrome');
  415.   writeln('16) EGA 640x350 Color');
  416.   writeln('20) HP-Multimode 640x400');
  417.   writeln('21) HP-Multimode 320x400');
  418.   goto ErrorExit;
  419. end;
  420.  
  421. { introduction }
  422. writeln(' There are an infinite number of pairs of points in a plane.');
  423. writeln(' This programs shows some of the strange fauna that exists');
  424. writeln(' based on the relationship between two points:');
  425. writeln;
  426. writeln('   Squiggle  - Seems to like to turn an twist in a smooth path.');
  427. writeln;
  428. writeln('   Lissajous - Ever seen the TV series "The Outer Limits" ?. Look');
  429. writeln('               at the source code, the relation between Squiggle');
  430. writeln('               and Lissajous is interesting.');
  431. writeln;
  432. writeln('   Planes    - Triangular planes turning this way and that ...');
  433. writeln;
  434. writeln('   Random    - What can I say, when all else fails go for the old');
  435. writeln('               and faithfull random number generator.');
  436. writeln;
  437. writeln(' written by Abe Achkinazi, May 1 1986.');
  438. writeln(' Updated to support color and multiple video adapters');
  439. writeln(' on August 6, 1986. Squiggles is based on a program');
  440. writeln(' written by Roderick Young.');
  441. writeln;
  442. writeln('Hit <return> to visit the ZOO and');
  443. writeln(' <return> once more to leave it.');
  444. readln;
  445.  
  446. GraphInit(GrfData, ScreenMode);
  447.  
  448. with GrfData do begin
  449.   OneThird := (MaxX - MinX + 1) div 3;
  450.   TwoThird := (MaxX - MinX + 1) div 3 + (MaxX - MinX + 1) mod 3;
  451.   OneHalf  := (MaxY - MinY + 1) div 2;
  452.  
  453.   { Initialize the different animals. }
  454.   Seed(list, Clip(MinX),               MinY,       Trim(OneThird-1), OneHalf-1, sines2);
  455.  
  456.   Seed(list2, Clip(OneThird),          MinY,       Trim(TwoThird-1), MaxY, sines);
  457.  
  458.   Seed(list3, Clip(OneThird+TwoThird), MinY,       Trim(OneThird-1), OneHalf-1, planar);
  459.  
  460.   Seed(list4, Clip(MinX),              OneHalf,    Trim(OneThird-1), OneHalf-1, random1);
  461.  
  462.   Seed(list5, Clip(OneThird+TwoThird), OneHalf,    Trim(OneThird-1), OneHalf-1, sines2);
  463.  
  464.   { Now go around and around given each a chance to perform }
  465.   repeat
  466.     Step(list);
  467.     Step(list2);
  468.     Step(list3);
  469.     Step(list4);
  470.     Step(list5);
  471.   until KeyPressed;
  472. end;
  473.  
  474. { if using extended modes turn off same way }
  475. if ScreenMode in [20, 21] then begin
  476.   Regs.ax := VidExtendedFunctions shl 8+5; Regs.bx := 3 end
  477. else 
  478.   Regs.ax := VidSetMode shl 8 + 3;
  479. Intr(VideoInt, Regs);
  480.  
  481. ErrorExit:;     { Falls to here when there is an error }
  482. end.
  483.